Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d18/vis082s.arc/CHATSTUF.PAS

Pascal/Delphi Source File | 1991-04-18 | 56.0 KB | 2,094 lines

{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }

unit chatstuf;        (* Chat Mode and F2 Keys *)

interface

uses crt,dos,
     gentypes,gensubs,subs1,userret,flags,mainr1,modem,windows,statret,
     configrt,ExecSwap,FastTTT5,WinTTT5,MenuTTT5,PullTTT5;

function specialcommand:boolean;
procedure specialseries;
procedure chat (gotospecial,color:boolean);
Procedure BustChat;

implementation


  procedure write1 (l:lstr);
  begin
   gotoxy (25,5);
   textcolor (12);
   textbackground (0);
   write (usr,l);
  end;

  function getstring (t:anystr):anystr;
  var mm,lz:anystr;
  begin
    textbackground (0);
    textcolor (12);
    write (usr,t);
    readline (mm);
    getstring:=mm;
  end;

function specialcommand:boolean;


Const Right=#205;       (* Constants used to define the arrow keys *)
      Left=#203;
      Up=#200;
      Down=#208;
      NormFore=15;      (* Color Constants *)
      NormBack=1;
      HighFore=1;
      HighBack=7;
      SwapLoc:Array[Boolean] of String[7]=('on disk','in EMS');  (* Full Mem
                                                                     Swaps *)

Var C:Char;
    Quit:Boolean;
    Major,Minor,Mainx,Mainy:Integer;
    Main_Choice,Choice,Error:integer;
    ScanTop, ScanBot:byte;
    M1,MM:Menu_record;
    Ch:char;
    X,Y:Byte;
    Done:Boolean;

    Function ReadStri:Mstr;
    Var MM:Mstr;
    Begin
      ReadLine(MM);
      ReadStri:=MM;
    End;

    Procedure SendMsg(M:Lstr);
    Begin
(*      ClearBreak;
      GotoXy(MainX,MainY);
      ClrEol;
      WriteLn(M); *)
    End;

    Procedure SplitEm;
    Var Cnt:Integer;
    Begin
      If SplitMode then Unsplit;
      GotoXy(1,15);
      TextColor(9);
      For Cnt:=1 to 80 Do Write(Usr,'─');
    End;

    Procedure ClearTop(Where:Byte);
    Var Cnt:Integer;
    Begin
      FillScreen(1,1,80,Where,blue,blue,chr(176)); Main_Choice:=1;
      TextColor(8);
      Textbackground(1);
      For CNT:=1 to 80 Do Begin
        Gotoxy(cnt,Where+1);
        Write(usr,'▄');
      End;
      TextColor(15);
    End;

    Procedure DrawABox(Count:Integer; Msg:Lstr);
    Var Cnt:Integer;
    Begin
    TextColor(9);
    TextBackground(NormBack);
    GotoXy(1,1);
    Write(Usr,'╒');
    For Cnt:=1 to 78 Do Write(Usr,'═');
    Write(Usr,'╕');
    For Cnt:=1 to Count Do
      Begin
      GotoXy(1,1+Cnt);
      Write(Usr,'│');
      GotoXy(80,1+Cnt);
      Write(Usr,'│');
      End;
    GotoXy(1,Count+2);
    Write(Usr,'╘');
    For Cnt:=1 to (38-(Length(Msg) div 2)) Do
     Write(Usr,'═');
     Textcolor(12);
     Write(Usr,'[ '+Msg+' ]');
     TextColor(9);
     While WhereX<80 Do Write(Usr,'═');
     Write(Usr,'╛');
     TextBackground(0);
    End;

    Procedure WriteXy(A,B:Integer; M:String);
    Begin
      GotoXy(A,B);
      Write(Usr,M);
    End;

    Procedure DoUserEditing;
    Var T:Mstr;
        Tx:Integer;
        LastMinor,Cnet:Integer;

     Procedure DoTop;
     Var Cnt:Integer;
     Begin
     ClearTop(20);
     DrawABox(17,'ViSiON v0.82 Online User Editing');
     Minor:=1;
    End;

    Procedure ClearBytes(Byt:Integer);
    Var X,Y,Cnt:Integer;
    Begin
      X:=WhereX;
      Y:=WhereY;
      For Cnt:=1 to Byt Do Write(Usr,' ');
      GotoXy(X,Y);
    End;

    Procedure DrawThem;
     Procedure yel;
     Begin
     Textcolor(14);
     End;
    Begin
      TextBackGround(NormBack);
      TextColor(NormFore);
      WriteXy(33,2,'Editing User #'+Strr(Unum)+'   ');
      Case LastMinor of
           1:Begin
              WriteXy(3,3,' Handle ');yel;
              WriteXy(16,3,urec.handle+'         ');
             End;
           2:Begin
              WriteXy(3,4,' Name ');yel;
              WriteXy(16,4,Urec.RealName+'           ');
             End;
           3:Begin
              WriteXy(3,5,' Level ');yel;
              WriteXy(16,5,Strr(Urec.Level)+'    ');
             End;
           4:Begin
              WriteXy(3,6,' G-F Lvl ');yel;
              WriteXy(16,6,Strr(Urec.Glevel)+'    ');
             End;
           5:Begin
              WriteXy(3,7,' G-F Pts ');yel;
              WriteXy(16,7,strr(Urec.Gpoints)+'    ');
             End;
            6:Begin
               WriteXy(3,8,' File Lvl ');yel;
               WriteXy(16,8,Strr(Urec.UDLevel)+'    ');
              End;
            7:Begin
               WriteXy(3,9,' File Pts ');yel;
               WriteXy(16,9,strr(Urec.UDPoints)+'    ');
              End;
            8:Begin
               WriteXy(3,10,' Password ');yel;
               WriteXy(16,10,Urec.PassWord+'    ');
              End;
            9:Begin
               WriteXy(3,11,' Phone Num ');yel;
               WriteXy(16,11,Urec.PhoneNum+'    ');
              End;
            10:Begin
                WriteXy(3,12,' Daily Time ');yel;
                WriteXy(16,12,strr(Urec.TimeLimits)+'    ');
               End;
            11:Begin
                WriteXy(3,13,' User Note ');yel;
                WriteXy(16,13,Urec.UserNote+'     ');
               End;
            12:Begin
                WriteXy(3,14,' Macro 1 ');yel;
                WriteXy(16,14,Urec.Macro1+'     ');
               End;
            13:Begin
                WriteXy(3,15,' Macro 2 ');yel;
                WriteXy(16,15,Urec.Macro2+'      ');
               End;
            14:Begin
                WriteXy(3,16,' Macro 3 ');yel;
                WriteXy(16,16,urec.macro3+'       ');
               End;
            15:Begin
                WriteXy(3,17,' Sysop Note ');yel;
                WriteXy(16,17,Urec.SpecialSysopNote+'    ');
               End;
            16:Begin
                WriteXy(57,3,' UD K Ratio ');yel;
                WriteXy(70,3,strr(Urec.UDKRatio)+'    ');
               End;
            17:Begin
                WriteXy(57,4,' PCR ');yel;
                WriteXy(70,4,strr(Urec.PCRatio)+'    ');
               End;
            18:WriteXy(57,5,' Time Left ');
            19:Begin
                WriteXy(57,6,' U/D Ratio ');yel;
                WriteXy(70,6,Strr(Urec.UDRatio)+'    ');
               End;
            20:Begin
                WriteXy(57,7,' Posts ');yel;
                WriteXy(70,7,Strr(Urec.Nbu)+'    ');
               End;
            21:Begin
                WriteXy(57,8,' Uploads ');yel;
                WriteXy(70,8,Strr(Urec.Uploads)+'  ');
               End;
            22:Begin
                WriteXy(57,9,' Downloads ');yel;
                WriteXy(70,9,Strr(Urec.Downloads)+'  ');
               End;
            23:Begin
                WriteXy(57,10,' U/L KB ');yel;
                WriteXy(70,10,Strr(Urec.UpKay)+'k');
               End;
            24:Begin
                WriteXy(57,11,' D/L KB ');yel;
                WriteXy(70,11,Strr(Urec.Dnkay)+'k');
               End;
            25:Begin
                WriteXy(57,12,' Calls ');yel;
                WriteXy(70,12,Strr(Urec.NumOn));
               End;
            26:Begin
                WriteXy(57,13,' Exp Date ');yel;
                If DateStr(Urec.ExpDate)='0/0/80' then WriteXy(70,13,'N/A      ')
                  Else
                WriteXy(70,13,DateStr(Urec.ExpDate));
               End;
            27:Begin
                WriteXy(57,14,' Wanted Flag ');yel;
                WriteXy(70,14,YesNo(Wanted in Urec.Config)+' ');
                End;
            28:Begin
                WriteXy(57,15,' Time bank ');yel;
                WriteXy(70,15,Strr(Urec.TimeBank)+'    ');
               End;
            29:Begin
                WriteXy(57,16,' GFile Uls ');yel;
                WriteXy(70,16,Strr(Urec.Nup)+'    ');
               End;
            30:Begin
                WriteXy(57,17,' GFile Dls ');yel;
                WriteXy(70,17,Strr(Urec.Ndn)+'  ');
               End;
            End; (* End Case *)
      TextBackGround(HighBack);
      TextColor(HighFore);
      Case Minor of
          1:WriteXy(3,3,' Handle ');
          2:WriteXy(3,4,' Name ');
          3:WriteXy(3,5,' Level ');
          4:WriteXy(3,6,' G-F Lvl ');
          5:WriteXy(3,7,' G-F Pts ');
          6:WriteXy(3,8,' File Lvl ');
          7:WriteXy(3,9,' File Pts ');
          8:WriteXy(3,10,' Password ');
          9:WriteXy(3,11,' Phone Num ');
          10:WriteXy(3,12,' Daily Time ');
          11:WriteXy(3,13,' User Note ');
          12:Writexy(3,14,' Macro 1 ');
          13:writexy(3,15,' Macro 2 ');
          14:writexy(3,16,' Macro 3 ');
          15:writexy(3,17,' SysOp Note ');
          16:WriteXy(57,3,' UD K Ratio ');
          17:WriteXy(57,4,' PCR ');
          18:WriteXy(57,5,' Time Left ');
          19:WriteXy(57,6,' U/D Ratio ');
          20:WriteXy(57,7,' Posts ');
          21:WriteXy(57,8,' Uploads ');
          22:WriteXy(57,9,' Downloads ');
          23:WriteXy(57,10,' U/L KB ');
          24:WriteXy(57,11,' D/L KB ');
          25:WriteXy(57,12,' Calls ');
          26:WriteXy(57,13,' Exp Date ');
          27:WriteXy(57,14,' Wanted Flag ');
          28:Writexy(57,15,' Time Bank');
          29:Writexy(57,16,' GFile ULs');
          30:writexy(57,17,' GFile DLs');
      End;
      LastMinor:=Minor;
      TextBackground(NormBack);
      TextColor(NormFore);
    End;

    Procedure Goty(X,Y,B:Integer);
    Begin
    GotoXy(X,Y);
    ClearBytes(b);
    End;

    Begin
      DoTop;
      LastMinor :=1;
      For Cnet:=1 to 30 Do
      Begin
        Minor:=Cnet;
        Drawthem;
        End;
      Minor:=1;
      DrawThem;
      Repeat
        C:=BiosKey;
         Case C Of
           Up:Dec(Minor);
           Down:Inc(Minor);
           Right,Left:If Minor<16 then Minor:=Minor+15 Else Minor:=Minor-15;
           #13:Begin
               If Minor<16 Then Goty(16,Minor+2,35)
                 Else
                 Goty(70,Minor+2-15,5);
               OnCursor;
               Case Minor Of
                1:Begin
                   T:=ReadStri;
                   If T<>'' then Urec.Handle:=T;
                   SendMsg('Your Handle has been changed to '+Urec.Handle);
                  End;
                2:Begin
                   T:=ReadStri;
                   If T<>'' then Urec.RealName:=T;
                   SendMsg('Your Real Name has been Changed to '+Urec.RealName);
                  End;
                3:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Level:=Tx;
                   Ulvl:=Tx;
                   SendMsg('You have been granted '+Strr(Urec.Level)+' Access.');
                  End;
                4:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Glevel:=Tx;
                   SendMsg('Your G-File Level has been changed to '+Strr(Urec.Glevel));
                  End;
                5:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Gpoints:=Tx;
                   SendMsg('You have been given '+Strr(Urec.Gpoints)+' G-File Points');
                  End;
                6:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Udlevel:=Tx;
                   SendMsg('Your Upload/Download Level has been set to '+Strr(Urec.UdLevel));
                  End;
                7:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.UdPoints:=Tx;
                   SendMsg('You now have '+strr(Urec.UdPoints)+' file points.');
                  End;
                8:Begin
                   T:=ReadStri;
                   If T<>'' then Urec.Password:=T;
                   SendMsg('Your password has been changed to '+Urec.Password);
                  End;
                9:Begin
                   T:=ReadStri;
                   If T<>'' then Urec.PhoneNum:=T;
                   SendMsg('Your Phone Number has been changed to '+Urec.PhoneNum);
                  End;
                10:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.TimeLimits:=Tx;
                    SendMsg('Your daily time limit has been set to '+Strr(Urec.TimeLimits));
                   End;
                11:Begin
                    T:=ReadStri;
                    If T<>'' then
                      Urec.UserNote:=T;
                    SendMsg('Your Account Note has been Changed to '+Urec.UserNote);
                   End;
                12:Begin
                    T:=ReadStri;
                    If T<>'' then Urec.Macro1:=T;
                    SendMsg('Your macro #1 has been changed to '+T);
                   End;
                 13:Begin
                    t:=readstri;
                    if t<>'' then Urec.Macro2:=T;
                    SendMsg('Your Macro #2 has been changed to '+T);
                   End;
                 14:Begin
                    t:=ReadStri;
                    If T<>'' then Urec.Macro2:=T;
                    SendMsg('Your Macro #3 has been changed to '+T);
                   End;
                15:Begin
                    T:=ReadStri;
                    If T<>'' then Urec.SpecialSysopNote:=T;
                   End;
                19:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.UDRatio:=Tx;
                    SendMsg('Your minimum Upload/Download ratio has been set to '+Strr(Urec.UdRatio));
                   End;
                16:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.UDKRatio:=Tx;
                    SendMsg('Your minimum Upload/Download K Ratio has been set to '+Strr(urec.Udkratio));
                   End;
                17:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.PCRatio:=Tx;
                    SendMsg('Your minimum Post/Call Ratio has been set to '+Strr(Urec.PCRatio));
                   End;
                18:Begin
                    T:=ReadStri;
                    GotY(70,5,5);
                    SetTimeLeft(Valu(T));
                    bottomline;
                    SendMsg('You have been given '+Strr(Valu(T))+' Minutes for today.');
                   End;
                20:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Nbu:=Tx;
                    SendMsg('Your POSTS have been set to '+Strr(Urec.Nbu));
                   End;
                21:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Uploads:=Tx;
                    SendMsg('Your Uploads have been set to '+Strr(Urec.Uploads));
                   End;
                22:Begin
                   T:=ReadStri;
                   Tx:=Valu(T);
                   Urec.Downloads:=Tx;
                   SendMsg('Your Downloads have been set to '+Strr(Urec.Downloads));
                  End;
                23:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.UpKay:=Tx;
                    SendMsg('Your Upload K-Bytes have been set to '+Strr(Tx)+'k');
                   End;
                24:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.DnKay:=Tx;
                    SendMsg('Your Download K-Bytes have been set to '+Strr(Tx)+'k');
                   End;
                25:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.NumOn:=Tx;
                    SendMsg('Your total calls have been set to '+Strr(Tx));
                   End;
                26:Begin
                    T:=ReadStri;
                    If T<>'' then Begin
                      Urec.ExpDate:=DateVal(T);
                      SendMsg('Your Expiration Date has been set to '+DateStr(Urec.ExpDate));
                   End;
                End;
                27:If Wanted in Urec.Config then Urec.Config:=Urec.Config-[Wanted] Else
                    Urec.Config:=Urec.Config+[Wanted];
                28:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.TimeBank:=Tx;
                    SendMsg('Your time in your time bank has been set to '+Strr(Tx));
                   End;
                 29:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Nup:=Tx;
                    SendMsg('Your G-File Uploads have been set to '+Strr(Tx));
                   End;
                 30:Begin
                    T:=ReadStri;
                    Tx:=Valu(T);
                    Urec.Ndn:=Tx;
                    SendMsg('Your G-File Downloads have been set to '+Strr(Tx));
                   End;
               End;
              OffCursor;
           End;
           End;
         If Minor=31 then Minor:=1;
         If Minor=0 then Minor:=30;
        DrawThem;
      Until C=#27;
      TextBackGround(0);
      FillScreen(1,1,80,24,white,blue,chr(176));
      Main_Choice:=1;
    End;

Procedure DoAccessFlags;
Var Quit:Boolean;
  Procedure DrawTop;
  Var Cnt:Integer;
  Begin
   DrawABox(4,'Access Flag Editing Commands');
   Minor:=1;
  End;

  Procedure GetMainConferences;

     Procedure DrawT;
     Var Cnt:Integer;
     Begin
       DrawABox(5,'Access to Main Conferences');
       Minor:=1;
     End;

   Procedure Choices;
   Var CountMe:Integer;
   Begin
    TextBackground(NormBack);
    TextColor(NormFore);
    for countme:=1 to 5 do
    Begin
      GotoXy(31,1+CountMe);
      Write(Usr,' Conference ',countme,' - ');
      if Urec.Conf[CountMe] then Write(Usr,'Yes ') else
       Write(Usr,'No  ');
    End;
    GotoXy(31,1+Minor);
    TextColor(HighFore);
    TextBackground(HighBack);
    Write(Usr,' Conference ',Minor,' - ');
    If Urec.Conf[Minor] then Write(Usr,'Yes ') else Write(Usr,'No  ');
    TextColor(NormFore);
    TextBackground(NormBack);
    End;


   Begin
     ClearTop(7);
     DrawT;
     Repeat
      Choices;
      C:=BiosKey;
      Case C Of
        Left,Up:Dec(Minor);
        Down,Right:Inc(Minor);
        #13:Begin
            Urec.Conf[Minor]:=Not Urec.Conf[Minor];
            If Urec.Conf[Minor] then SendMsg('You have been granted access to main conference #'+Strr(Minor))
            Else SendMsg('You have been denied access to Main Conference #'+Strr(Minor));
          End;
       End;
       If Minor>5 then Minor:=1;
       If Minor<1 then Minor:=5;
      Until C=#27;
      FillScreen(1,1,80,24,white,blue,chr(176));
      Main_Choice:=1;
   End;

  Procedure GetSubConferences;
  Var T:Mstr;
      Tx:Integer;

  Procedure ShowSubs;
   Var Cnt:Integer;
   Begin
     ClearTop(7);
     GotoXy(1,1);
     WriteLn(Usr,'                       Sub Conference Access Flags');
     Write(Usr,^M^J);
     Write(Usr,'         ');
     For Cnt:=1 to 18 do
      If Urec.Confset[Cnt]>0 then Write(Usr,Cnt,',') Else
      Write(Usr,'0,');
     Write(Usr,^M^J);
     Write(Usr,'         ');
     For Cnt:=19 to 31 Do
       If Urec.Confset[Cnt]>0 then Write(Usr,Cnt,',') Else
       Write(Usr,'0,');
     If Urec.ConfSet[32]>0 then WriteLn(Usr,'32') else writeLn(Usr,'0');
   End;

   Begin
     Repeat
       ShowSubs;
       Write(Usr,^M^J);
       Write(Usr,'Enter conference to change, or [Return] to exit:');
       T:=ReadStri;
       If T<>'' then Begin
         Tx:=Valu(T);
         If (Tx>0) and (TX<33) then
           If Urec.ConfSet[Tx]=0 then Urec.Confset[Tx]:=1 Else
           Urec.Confset[Tx]:=0;
         End;
       Until T='';
       FillScreen(1,1,80,24,white,blue,chr(176));
       Main_Choice:=1;
     End;

  procedure getnewaccess;
  var q,bname:sstr;
      bn:integer;
      ac:accesstype;
      wasopen:boolean;
      k:char;

    function inputaccess (q:sstr):accesstype;
    begin
      inputaccess:=invalid;
      if length(q)=0 then exit;
      case upcase(q[1]) of
        'L':inputaccess:=letin;
        'B':inputaccess:=bylevel;
        'K':inputaccess:=keepout
      end
    end;

    procedure getallaccess;

      procedure setallaccess (ac:accesstype);
      var cnt:integer;
      begin
        setalluserflags (urec,ac);
        SendMsg ('Your access to all sub-boards: '+accessstr[ac]);
        writeurec
      end;

    begin
      Write (Usr,'ALL acc. ([B]y level, [L]et in, [K]eep out, or CR): ');
      Q:=ReadStri;
      ac:=inputaccess(q);
      if ac<>invalid then setallaccess(ac)
    end;

  var bd:boardrec;
  begin
    ClearTop(7);
    GotoXy(25,1);
    WriteLn(Usr,'Change Sub-Board Access');
    GotoXy(1,3);
    Write(Usr,'Which Sub-Board to change access for [''*''/ALL]: ');
    Bname:=ReadStri;
    if length(bname)<1 then Begin FillScreen(1,1,80,24,white,blue,chr(176)); exit; End;
    if bname='*' then
      begin
        getallaccess;
        FillScreen(1,1,80,24,white,blue,chr(176));
        main_choice:=1;
        exit
      end;
    opentempbdfile;
    bn:=searchboard(bname);
    if bn=-1 then
      begin
        closetempbdfile;
        Write(Usr,'No such board! Press any key..');
        k:=bioskey;
        FillScreen(1,1,80,24,white,blue,chr(176));
        main_choice:=1;
        exit
      end;
    writeln (Usr,'Board '+bname+'... Current access: '+accessstr[getuseraccflag(urec,bn)]);
    Write(Usr,'Access ([B]y level, [L]et in, [K]eep out, or [CR]: ');
    q:=readstri;
    ac:=inputaccess(q);
    if ac=invalid then begin
      closetempbdfile;
      FillScreen(1,1,80,24,white,blue,chr(176));
      main_choice:=1;
      exit
    end;
    setuseraccflag (urec,bn,ac);
    writeurec;
    closetempbdfile;
    SendMsg ('New access for sub-board '+bname+': '+accessstr[ac]);
    FillScreen(1,1,80,24,white,blue,chr(176));
    main_choice:=1;
  end;

  procedure getsysopaccess;
  const sysopstr:array [false..true] of string[6]=('Normal','Sysop');
        sectionnames:array [udsysop..databasesysop] of string[20]=
          ('File transfer','Bulletin section','Voting booths',
           'E-mail section','Doors','Main menu','Databases');
  var cnt:configtype;
      x:string[10];
      n,mx:integer;
      v:boolean;
  begin
    repeat
      ClearTop(10);
      GotoXy(1,1);
      mx:=1;
      for cnt:=udsysop to databasesysop do begin
        write (usr,mx:3,'. ',sectionnames[cnt]);
        mx:=mx+1;
        gotoxy (25,wherey);
        writeln (usr,sysopstr[cnt in urec.config])
      end;
      write (usr,^M^J'Number to toggle [CR to exit]: ');
      readline (x);
      n:=valu(x);
      v:=(n>0) and (n<mx);
      if v then begin
        cnt:=configtype(ord(udsysop)+n-1);
        if cnt in urec.config
          then
            begin
              urec.config:=urec.config-[cnt];
              x:='denied'
            end
          else
            begin
              urec.config:=urec.config+[cnt];
              x:='granted'
            end;
        SendMsg ('You have been '+x+' sysop priveleges for the '+
                 sectionnames[cnt]+'.')
      end
    until not v;
    writeurec;
    FillScreen(1,1,80,24,white,blue,chr(176));
    main_choice:=1;
  end;

Procedure Which_Flag;
begin
    Menu_Set(M1);
    With M1 do
    begin
        Heading1 := '';
        Heading2 := 'Confernce/Flag/Access Editing';
        Topic[1] := '   Main Conference [1-5]';
        Topic[2] := '   Access Flags [1-30]';
        Topic[3] := '   Sub-Board Access (Msgs) ';
        Topic[4] := '   SysOp Access Flags';
        Topic[5] := '   Quit To Main SysOp Menu ';
        TotalPicks := 5;
        PicksPerLine := 1;            {one column of choices}
        Addprefix := 1;               {add function key prefixes}
        TopleftXY[1] := 5;            {system will center menu}
        TopleftXY[2] := 6;           {Y coordinate}
        Boxtype := 5;                 {fancy box}
        If ColorScreen then
        begin
            Colors[1] := white;           {hi forground}
            Colors[2] := magenta;            {hi background}
            Colors[3] := lightgray;             {lo foreground}
            Colors[4] := red;       {lo background}
            Colors[5] := lightgray;            {box color}
        end
        else
        begin
            Colors[1] := white;           {hi forground}
            Colors[2] := black;            {hi background}
            Colors[3] := black;             {lo foreground}
            Colors[4] := lightgray;       {lo background}
            Colors[5] := white;            {box color}
        end;
        AllowEsc := false;            {inactivate the escape key}
        Margins := 5;
end;  {with M1 do}
end; {Define_Menu1}

Begin
    Quit:=False;
    Findcursor(X,Y,ScanTop,ScanBot);
    Main_Choice := 1;
    Done:=False;
    Buflen:=40;
    repeat
     Which_Flag;
     DisplayMenu(M1,false,Main_Choice,Error);
     Case Main_Choice of
     1:GetMainConferences;
     2:GetSubConferences;
     3:GetNewAccess;
     4:GetSysOpAccess;
     5:Quit:=True;
     end;  {case}
until Quit;
FillScreen(1,1,80,24,white,blue,chr(176));
main_choice:=1;
End;

Procedure Which_Other;
begin
    Menu_Set(M1);
    With M1 do
    begin
        Heading1 := '';
        Heading2 := 'Other SysOp Commands';
        Topic[1] := '   Hang Up On User';
        Topic[2] := '   Delete User (Nuke)';
        Topic[3] := '   Snoop Mode [ON]';
        Topic[4] := '   Snoop Mode [OFF]';
        Topic[5] := '   Quit To Main SysOp Menu ';
        TotalPicks := 5;
        PicksPerLine := 1;            {one column of choices}
        Addprefix := 1;               {add function key prefixes}
        TopleftXY[1] := 28;           {system will center menu}
        TopleftXY[2] := 13;           {Y coordinate}
        Boxtype := 5;                 {fancy box}
        If ColorScreen then
        begin
            Colors[1] := white;           {hi forground}
            Colors[2] := magenta;            {hi background}
            Colors[3] := lightgray;             {lo foreground}
            Colors[4] := red;       {lo background}
            Colors[5] := lightgray;            {box color}
        end
        else
        begin
            Colors[1] := white;           {hi forground}
            Colors[2] := black;            {hi background}
            Colors[3] := black;             {lo foreground}
            Colors[4] := lightgray;       {lo background}
            Colors[5] := white;            {box color}
        end;
        AllowEsc := false;            {inactivate the escape key}
        Margins := 5;
end;  {with M1 do}
end; {Define_Menu1}

Procedure DoOther;
Var Quit:Boolean;
Begin
    Quit:=False;
    Findcursor(X,Y,ScanTop,ScanBot);
    Main_Choice := 1;
    Done:=False;
    Buflen:=40;
    repeat
     Which_Other;
     DisplayMenu(M1,false,Main_Choice,Error);
     Case Main_Choice of
     1:Begin
         gotoxy(1,25);
         Write('Sorry but the BBS is going down right now!');
         ForceHangup:=True;
         HangUp;
        End;
     2:Begin
         Urec.Level:=-1;
         gotoxy(1,25);
         Write('You''re Nuked BUDDY!');
         ForceHangup:=True;
         HangUp;
        End;
     3:Begin
         ModemInlock:=True;
         SetOutLock(True);
         gotoxy(1,25);
         Sound(500);
         NoSound;
        End;
     4:Begin
        gotoxy(1,25);
        Sound(250);
        NoSound;
        ModemInlock:=False;
        SetOutLock(False);
       End;
     5:Quit:=True;
     end;  {case}
until Quit;
FillScreen(1,1,80,24,white,blue,chr(176));
main_choice:=1;
End;

procedure gotodos (i:integer);
  var status:word;
      tmp1:integer;
      st:mstr;
  begin
    gotoxy(1,25);
    Write ('■ Sysop in DOS ■');
    ansicolor(15);
    window (1,1,80,25);
    gotoxy (1,25);
    writeln (usr,^M^J^J^J);
    updateuserstats (false);
    if i=1 then begin
       textbackground(0);
       clrscr; textcolor(15);
       writeln(usr,'«« ViSiON Dos Shell »»');
       writeln(usr,'Type ''EXIT'' to return.'^M);
       tmp1:=timeleft;
       if not configset.maximumdosshell then begin
        swapvectors;
        exec(getenv('COMSPEC'),'');
        swapvectors;
       End Else Begin
         WriteLn(Usr,'Allocated ',bytesswapped,' bytes ',swaploc[EmsAllocated]);
         SwapVectors;
         Status:=ExecWithSwap(GetEnv('Comspec'),'');
         SwapVectors;
        End;
       st:=configset.forumdi;
       if st[length(st)]='\' then st[length(st)]:=#0;
       chdir(st);
       settimeleft(tmp1);
       bottomline;
       end else if i=2 then begin
     ensureclosed;
     writereturnbat;
     closeport;
     halt (4);
    end;
    Textbackground(0);
    ClrScr;
    FillScreen(1,1,80,24,white,blue,chr(176));
  end;

procedure runconfig;
var status:word;
begin
 if configset.forumdi[length(configset.forumdi)]<>'\' then configset.forumdi:=configset.forumdi+'\';
 swapvectors;
 exec(getenv('COMSPEC'), '/C CONFIG.EXE');
 swapvectors;
 readconfig;
 FillScreen(1,1,80,24,white,blue,chr(176));
end;

procedure dotexteditor;
  begin
    if length(configset.edito)<1 then exit;
    window (1,1,80,25);
    gotoxy (1,25);
    writeln (usr,^M^J^J^J);           updateuserstats (false);
    exec(GetEnv('COMSPEC'), '/C '+configset.edito);
    FillScreen(1,1,80,24,white,blue,chr(176));
  end;


Procedure Which_SysOp;
begin
    Menu_Set(M1);
    With M1 do
    begin
        Heading1 := 'ViSiON v0.82 By: Crimson Blade';
        Heading2 := 'Online SysOp Commands';
        Topic[1] := '   ViSiON SysOp User Editor ';
        Topic[2] := '   Set User Access Flags';
        Topic[3] := '   Other Commands';
        Topic[4] := '   Shell To DOS';
        Topic[5] := '   Full Drop To DOS';
        Topic[6] := '   Run Configuration Program ';
        Topic[7] := '   Run Text Editor';
        Topic[8] := '   Chat Commands';
        Topic[9] := '   Quit SysOp Commands';
        TotalPicks := 9;
        PicksPerLine := 1;            {one column of choices}
        Addprefix := 1;               {add function key prefixes}
        TopleftXY[1] := 0;            {system will center menu}
        TopleftXY[2] := 4;            {Y coordinate}
        Boxtype := 5;                 {fancy box}
        If ColorScreen then
        begin
            Colors[1] := white;           {hi forground}
            Colors[2] := magenta;            {hi background}
            Colors[3] := lightgray;             {lo foreground}
            Colors[4] := blue;       {lo background}
            Colors[5] := lightgray;            {box color}
        end
        else
        begin
            Colors[1] := white;           {hi forground}
            Colors[2] := black;            {hi background}
            Colors[3] := black;             {lo foreground}
            Colors[4] := lightgray;       {lo background}
            Colors[5] := white;            {box color}
        end;
        AllowEsc := false;            {inactivate the escape key}
        Margins := 5;
end;  {with M1 do}
end; {Define_Menu1}

Begin
    WriteLn(^R'■ '^A'One Moment'^R' ■');
    SplitScreen(25);
    Activate_Visible_Screen;
    textbackground(0);
    Clrscr;
    FillScreen(1,1,80,24,white,blue,chr(176));
    Findcursor(X,Y,ScanTop,ScanBot);
    OffCursor;
    Main_Choice := 1;
    Done:=False;
    Buflen:=40;
    Textbackground(0);
    repeat
     Which_SysOp;
     DisplayMenu(M1,false,Main_Choice,Error);
     Case Main_Choice of
     1:Begin ClrScr; DoUserEditing; End;
     2:Begin DoAccessFlags; End;
     3:Begin DoOther; End;
     4:Begin ClrScr; Gotodos(1); End;
     5:Begin ClrScr; Gotodos(2); End;
     6:Begin ClrScr; RunConfig; End;
     7:Begin ClrScr; DoTextEditor; End;
     8:Begin Done:=True; BustChat; Done:=True; End;
     9:Done:=True;
     end;  {case}
until Done;
OnCursor;
ClrScr;
UnSplit;
Main_Choice:=1;
End;

procedure specialseries;
begin
  repeat until specialcommand
end;

procedure chat (gotospecial,color:boolean);
var k:char;
    StartedTime:Word;
    cnt,displaywid:integer;
    quit,carrierloss,fromkbd:boolean;
    baudstr,commstr:mstr;
    c1,c2,c3,c4,c5,c6,c7,c8,backup:integer;


    xsys     :byte;
    ysys     :byte;
    xusr     :byte;
    yusr     :byte;
    curcolor :byte;
    ec       :byte;
    initi    :boolean;
    linebufs :string[80];
    linebufu :string[80];

procedure init;
begin
  xsys     :=1;
  ysys     :=14;
  xusr     :=1;
  yusr     :=4;
  curcolor :=1;
  ec       :=1;
  initi    :=true;
  linebufs :='';
  linebufu :='';
  inuse:=2;
end;


procedure sendxy (x,y:byte);
begin
 write(#27+'[',y,';',x,'H');

end;


Procedure clearscre;
 var i:byte;
 begin
 for I:=4 to 23 do
  begin
   sendxy(1,i);
   write(#27'[K');
   end;
 end;


Procedure setc;
begin
   if fromkbd then ec:=urec.statcolor else ec:=urec.inputcolor;
   if curcolor<>ec then begin
   curcolor:=ec;
  end;
end;


procedure midline;
 begin
   sendxy(1,13);
   write(^R'───────────────────────────'^S' '^P'ViSiON '+versionnum+' - '+timestr(now)+^R);
   write(' ───────────────────────────');
   sendxy(trunc((21-length(configset.sysopnam))/2),13);
   write (^R'─ '^S+configset.sysopnam+^R' ─');
   sendxy(trunc((24-length(urec.handle))/2)+52,13);
   write (^R'─ '^S+urec.handle+^R' ─');
 end;

Procedure cle (malig:byte);
var i    :byte;
begin
if malig=0 then
begin
  for i:=14 to 23 do
 begin
    sendxy(1,i);
        ansicolor(1);
    write(#27'[K');
 end;
 sendxy(1,14);
 malig:=0;
end;

if malig=1 then
begin
    for i:=4 to 12 do
 begin
  sendxy(1,i);
  ansicolor(1);
  write(#27,'[K');
 end;
 sendxy(1,4);
 malig:=0;
end;



end;

  procedure wordwrapit(yeanea:byte);
  var cnt       :byte;
      wl        :integer;
      ww        :lstr;
      cutarea   :byte;
      done      :boolean;
  begin
   done:=false;
   cutarea:=0;
   ww:='';
   cnt:=80;
   if yeanea=0 then
     begin
      If Pos(' ',LineBufs)<=0 then Begin
        Writeln;
        LineBufs:='';
        Xsys:=1;
        Inc(Ysys);
        Exit;
      End;
    repeat
      if not done and (copy(linebufs,cnt,1)=' ') then cutarea:=cnt;
      if (cutarea>0) and not done then
        begin
        ww:=copy(linebufs,cnt+1,255);
         ansicolor(urec.statcolor);
         sendxy(cutarea,ysys);
         write(#27'[K');
         inc(ysys);
         xsys:=1;
         sendxy(xsys,ysys);
         write(copy(linebufs,cutarea+1,80-cutarea));
         xsys:=length(copy(linebufs,cutarea+1,80-cutarea))+1;
         sendxy(xsys,ysys);
         dec(ysys);
         done:=true
        end;
      dec(cnt);
     until cnt=1;
    linebufs:=ww;
   end;

   if yeanea=1 then
   begin
    If Pos(' ',LineBufu)<=0 then Begin
       Writeln;
       Inc(Yusr);
       Xusr:=0;
       LineBufu:='';
       Exit;
    End;
   done:=false;
   cutarea:=0;
   ww:='';
   cnt:=80;
    repeat
      if not done and (copy(linebufu,cnt,1)=' ') then cutarea:=cnt;
      if (cutarea>0) and not done then
        begin
        ww:=copy(linebufu,cnt+1,255);
         ansicolor(urec.inputcolor);
         sendxy(cutarea,yusr);
         write(#27'[K');
         inc(yusr);
         xusr:=1;
         sendxy(xusr,yusr);
         write(copy(linebufu,cutarea+1,80-cutarea));
         xusr:=length(copy(linebufu,cutarea+1,80-cutarea))+1;
         sendxy(xusr,yusr);
         dec(yusr);
         done:=true
        end;
      dec(cnt);
     until cnt=1;
    linebufu:=ww;
   end;
end;


 Procedure locate;
 begin
   if fromkbd then
 begin

     if (xsys=80) and (ysys<23) then
    begin
     wordwrapit(0);
     inc(ysys);
    end;
    if ((ysys=23) and (xsys=80)) or (ysys>23) then
    begin
    cle(0);
    ysys:=14;
    xsys:=1;
    sendxy(xsys,ysys);
    ansicolor(urec.statcolor);
    write(^S+linebufs);
        ansireset;
    sendxy(80-length(linebufs)+1,ysys);
        ansireset;
    wordwrapit(0);
    inc(ysys);
    sendxy(xsys,ysys);
 end;

  sendxy(xsys,ysys);
  inc(xsys);
 end;
   if not fromkbd then
 begin
   if (xusr=80) and (yusr<12) then
  begin
   wordwrapit(1);
   inc(yusr);
  end;
if ((yusr=12) and (xusr=80)) or (yusr>12) then
 begin
   cle(1);
   yusr:=4;
   xusr:=1;
   sendxy(xusr,yusr);
   ansicolor(urec.inputcolor);
   write(^U+linebufu);
   ansireset;
   sendxy(80-length(linebufu)+1,yusr);
   ansireset;
   wordwrapit(1);
   inc(yusr);
   sendxy(xusr,yusr);
 end;

   sendxy(xusr,yusr);
   inc(xusr);
 end;
end;

  procedure instruct;
  var i:integer;
  begin
 for i:=1 to 5 do
   begin
     sendxy(1,i);
     write(#27,'[K');
     end;
     splitscreen (2);
    top;
    clrscr;
    write (usr,'Now in Chat mode. Press [F1] to leave or [F2] for commands.');
    initi:=false;
    bottom;
    sendxy(1,4);
  end;

  Procedure ChangeVars;
      Begin
       backup:=c1;
       c1:=c2; c2:=c3; c3:=c4; c4:=c5; c5:=c6; c6:=c7; c7:=c8; c8:=backup;
       ansicolor(c1);
      End;

    Procedure GetCrazyVars;
      Begin
       If Color Then Begin
       c1:=configset.kkk1; c2:=configset.kkk2; c3:=configset.kkk3;
       c4:=configset.kkk4; c5:=configset.kkk5; c6:=configset.kkk6;
       c7:=configset.kkk7; c8:=configset.kkk8;
      End Else Begin
       c1:=urec.inputcolor;
       End;
      End;


procedure typedchar (k:char);

   begin
   ChangeVars;
   locate;
   begin;
   If (c1<1) and (c1>15) then getcrazyvars;
   if fromkbd then begin If Color then ansicolor(c1) else ansicolor(urec.statcolor); linebufs:=linebufs+K;
   end;
   if not fromkbd then begin If Color then ansicolor(c1) else ansicolor(urec.inputcolor); linebufu:=linebufu+K;
   end;
    write(k)
   end;
  end;


begin
  carrierloss:=false;
  chatmode:=false;
  writeln (^B^M);
  if wanted in urec.config then begin
    specialmsg ('(No longer wanted)');
    urec.config:=urec.config-[wanted];
    writeurec;
  end;
  if eightycols in urec.config then displaywid:=80 else displaywid:=40;
  if gotospecial then begin
    specialseries;
    exit
  end;
  clearbreak;
  nobreak:=true;
  writeln (^M^M,configset.entercha,^M^R);
  StartedTime:=TimeLeft;
  instruct;
  if not initi then
begin
  CLEARSCRE;
  Sendxy(1,13); ANSiCOLOR(15);
  WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
  Sendxy(1,13); ANSiCOLOR(7);
  WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
  Sendxy(1,13); ANSiCOLOR(8);
  WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
   if color then GetCrazyVars;
   init;
   clearscre;
   midline;
end;

  quit:=false;
  nobreak:=true;
  break:=false;
  repeat
    linecount:=0;
    if (not carrierloss) and (not carrier) then begin
      carrierloss:=true;
      gotoxy(1,4);
      writeln (^M'Warning: There is no carrier present.'^M)

    end;
    repeat until keyhit or (carrier and (numchars>0));
    fromkbd:=keyhit;
    ingetstr:=true;
    if fromkbd then
     k:=bioskey else
    k:=getchar;
    if k=#127 then k:=#8;
    if k > #127 then if ((ord(k) - 128) in [59,60]) then begin
      if (ord(k) - 128) = 60 then begin
        quit:=specialcommand;
        if not quit then instruct;
        clearbreak;
        unsplit;
      end;
      nobreak:=true;
      writeln (^M^M,configset.exitcha,^M^R);
      SetTimeLeft(StartedTime);
      write (#27'[J');
      bottomline;
      chainstr:='';
      input:='';
      write (lastprompt);
      exit;
    end;
    case ord(k) of
      8:begin
      if (xsys>1) and fromkbd then
       begin
          modeminlock:=true;
          if xsys>1 then dec(xsys);
          sendxy(xsys,ysys);
          write (' ');
          sendxy(xsys,ysys);
          if length(linebufs)>0 then linebufs:=copy(linebufs,1,length(linebufs)-1);
          modeminlock:=false;
        end;
      if (xusr>1) and not fromkbd then
       begin
          modeminlock:=true;
          if xusr>1 then dec(xusr);
          sendxy(xusr,yusr);
          write (' ');
          sendxy(xsys,ysys);
          if length(linebufu)>0 then linebufu:=copy(linebufu,1,length(linebufu)-1);
          modeminlock:=false;
        end;
     end;
      0:;
      13:begin
           writeln;
           bottomline;
          if fromkbd then begin
           xsys:=1;
           inc(ysys);
       if (ysys>=21) then
         begin
          cle(0);
           ysys:=14;
           xsys:=1;
           sendxy(xsys,ysys);
           ansicolor(urec.statcolor);
           write(linebufs);
           ysys:=15;
           xsys:=1;
           end;
           sendxy(xsys,ysys);
           linebufs:='';
           end;

          if not fromkbd then begin
           xusr:=1;
           inc(yusr);
       if (yusr=13) then
              begin
                 cle(1);
                  yusr:=4;
                  xusr:=1;
                   ansicolor(urec.inputcolor);
                  sendxy(xusr,yusr);
                  write(linebufu);
                  yusr:=5;
                  sendxy(xusr,yusr);
              end;
            sendxy(xusr,yusr);
          linebufu:='';
          end;
         end;
      32..255:typedchar (k);
      1..31:if fromkbd and carrier then sendchar(k);
    end
  until quit;
  clearbreak
end;


Procedure OnelineChat;
VAR k:char;
    cnt,displaywid:integer;
    StartedTime:Word;
    quit,carrierloss,fromkbd:boolean;
    linebuffer:lstr;
    l:byte absolute linebuffer;
    curcolor:byte;

  Procedure instruct;
  begin
    splitscreen (3);
    top;
    clrscr;
    write (usr,'Now in chat mode.  Press <F1> to leave or <F2> for commands.');
    bottom
  end;

  Procedure wordwrap;
  VAR cnt,wl:integer;
      ww:lstr;
  begin
    ww:='';
    cnt:=displaywid;
    while (cnt>0) and (linebuffer[cnt]<>' ') do cnt:=cnt-1;
    if cnt=0 then ww:=k else begin
      ww:=copy(linebuffer,cnt+1,255);
      wl:=length(ww)-1;
      if wl>0 then begin
        for cnt:=1 to wl do write (^H);
        for cnt:=1 to wl do write (' ')
      end
    end;
    writeln;
    ansicolor (curcolor);
    write (ww);
    linebuffer:=ww
  end;

  Procedure typedchar (k:char);
  VAR ec:byte;
  begin
    l:=l+1;
    linebuffer[l]:=k;
    if l=displaywid then wordwrap else write(k)
  end;

VAR Ch : CHAR;
    inchat:boolean;
begin
  While Keypressed DO
    Ch := ReadKey;
  Writeln(^M);
  carrierloss := false;
  chatmode := false;
  InChat := TRUE;
  writeln(^B);
  if (wanted in urec.config) AND (Ulvl < 90)  then begin
    specialmsg ('(No longer wanted)');
    urec.config:=urec.config-[wanted];
    writeurec;
  end;
  if eightycols in urec.config then displaywid:=80 else displaywid:=40;
  if length(chatreason)>0 then specialmsg ('(Chat reason: '+chatreason+')');
  chatreason:='';
  clearbreak;
  nobreak := TRUE;
  Writeln (^M^M^R,configset.entercha,^M^M);
  StartedTime:=TimeLeft;
  instruct;
  quit:=false;
  l:=0;
  curcolor:=urec.regularcolor;
  nobreak:=true;
  repeat
    linecount:=0;
    if (not carrierloss) and (not carrier) then begin
      carrierloss:=true;
      writeln (^M'Warning: No Carrier detected.'^M)
    end;
    repeat until keyhit or (carrier and (numchars>0));
    fromkbd:=keyhit;
    ingetstr:=true;
    curcolor:=urec.inputcolor;
    if not keyhit then read(directin,k) else begin curcolor:=urec.statcolor;
    K:=bioskey;
    if (ord(k)>127) then if ((ord(k)-128)=chatchar) then inchat:=false;
    if (ord(k)>127) then if ((ord(k)-129)=chatchar) then begin specialseries;
    inchat:=false;
    end;
    end;
    ansicolor(curcolor);
    if k=#127 then k:=#8;
    Quit := NOT Inchat;
    if quit then k:=#0;
    case ord(k) of
      8:if l>0 then begin
          write (k+' '+k);
          l:=l-1
        end;
      0:;
      13:begin
           writeln;
           bottomline;
           l:=0
         end;
      32..255:typedchar (k);
      1..31:if fromkbd and carrier then sendchar(k)
    end
  until quit;
  chainstr:='';
  input:='';
  UnSplit;
  ClearBreak;
  Writeln(^M^M^R,configset.exitcha,^M);
  SetTimeLeft(StartedTime);
  bottomline;
End;

procedure regchat(color:Boolean); (* Vertical Chat *)
var k:char;
    StartedTime:Word;
    cnt,displaywid:integer;
    quit,carrierloss,fromkbd:boolean;
    baudstr,commstr:mstr;
    c1,c2,c3,c4,c5,c6,c7,c8,backup:integer;


    xsys     :byte;
    ysys     :byte;
    xusr     :byte;
    yusr     :byte;
    curcolor :byte;
    ec       :byte;
    initi    :boolean;
    linebufs :string[38];
    linebufu :string[38];

procedure init;
begin
  xsys     :=1;
  ysys     :=5;
  xusr     :=42;
  yusr     :=5;
  curcolor :=1;
  ec       :=1;
  initi    :=true;
  linebufs :='';
  linebufu :='';
  inuse:=2;
end;


procedure sendxy (x,y:byte);
begin
 write(#27+'[',y,';',x,'H');
end;


Procedure clearscre;
 var i:byte;
 begin
 for I:=1 to 24 do
  begin
   sendxy(1,i);
   write(#27'[K');
   end;
 end;


Procedure setc;
begin
   if fromkbd then ec:=urec.statcolor else ec:=urec.inputcolor;
   if curcolor<>ec then begin
   curcolor:=ec;
  end;
end;

 procedure midline;
 var i:byte;
 begin
   unsplit;
   clearscre;
   ClearScr;
   sendxy(1,2);
   write(^P'───────────────────────────────────────┬──────────────────────────────────────');
   sendxy(trunc((21-length(configset.sysopnam))/2),1);
   write (^A'■ '^S+configset.sysopnam+^A' ■');
   sendxy(trunc((24-length(urec.handle))/2)+52,1);
   write (^A'■ '^S+urec.handle+^A' ■');
   sendxy(1,3); ansicolor(31);
   Write('  ViSiON Vertical Split Screen Chat   ');
   sendxy(42,3); ansicolor(31);
   Write('  ViSiON Vertical Split Screen Chat  ');
   For i:=3 to 23 Do Begin
   Sendxy(40,i);
   Write(^P'│');
 end;
End;

Procedure cle (malig:byte);
var i,x    :byte;

begin
if malig=0 then
begin
   for i:=4 to 22 do
 begin
    sendxy(1,i);
  write('                                      ');
 end;
 sendxy(1,4);
 malig:=0;
end;

if malig=1 then
begin
  for i:=4 to 22 do
 begin
  sendxy(42,i);
  write('                                     ');
 end;
 sendxy(42,4);
 malig:=0;
end;
end;

  procedure wordwrapit(yeanea:byte);
  var cnt       :byte;
      wl        :integer;
      ww        :lstr;
      cutarea   :byte;
      done      :boolean;
  begin
   done:=false;
   cutarea:=0;
   ww:='';
   cnt:=80;
   if yeanea=0 then
     begin
      If Pos(' ',LineBufs)<=0 then Begin
        Writeln;
        LineBufs:='';
        Xsys:=1;
        Inc(Ysys);
        Exit;
      End;
    repeat
      if not done and (copy(linebufs,cnt,1)=' ') then cutarea:=cnt;
      if (cutarea>0) and not done then
        begin
        ww:=copy(linebufs,cnt+1,255);
         ansicolor(urec.statcolor);
         sendxy(cutarea,ysys);
(*         write('                                    '); *)
         inc(ysys);
         xsys:=1;
         sendxy(xsys,ysys);
         write(copy(linebufs,cutarea+1,80-cutarea));
         xsys:=length(copy(linebufs,cutarea+1,80-cutarea))+1;
         sendxy(xsys,ysys);
         dec(ysys);
         done:=true
        end;
      dec(cnt);
     until cnt=1;
    linebufs:=ww;
   end;

   if yeanea=1 then
   begin
    If Pos(' ',LineBufu)<=0 then Begin
       Inc(Yusr);
       Xusr:=42;
       LineBufu:='';
       sendxy (xusr,yusr);
       Exit;
    End;
   done:=false;
   cutarea:=0;
   ww:='';
   cnt:=80;
    repeat
      if not done and (copy(linebufu,cnt,1)=' ') then cutarea:=cnt;
      if (cutarea>0) and not done then
        begin
        ww:=copy(linebufu,cnt+1,255);
         ansicolor(urec.inputcolor);
(*         sendxy(cutarea,yusr);
         write('                                    '); *)
         inc(yusr);
         xusr:=42;
         sendxy(xusr,yusr);
(*         write(copy(linebufu,cutarea+1,80-cutarea+40)); *)
         sendxy(42,yusr);
         write(linebufu);
         xusr:=length(copy(linebufu,cutarea+1,80-cutarea))+1; (* Added +40 *)
         sendxy(xusr,yusr);
         dec(yusr);
         done:=true
        end;
      dec(cnt);
     until cnt=1;
    linebufu:=ww;
   end;
end;


 Procedure locate;
 begin
   if fromkbd then begin
     if (xsys=39) and (ysys<22) then begin
    {  wordwrapit(0); }
       xsys:=1;
       inc(ysys);
     end;
     if ((ysys=22) and (xsys=39)) or (ysys=22) then begin
       cle(0);
       ysys:=4;
       xsys:=1;
       sendxy(xsys,ysys);
       write(^S+linebufs);
       sendxy(80-length(linebufs)+1,ysys);
    {  wordwrapit(0); }
       ysys:=5;
       sendxy(xsys,ysys);
     end;
     sendxy(xsys,ysys);
     inc(xsys);
   end else begin
     if (xusr=77) and (yusr<22) then begin
     { wordwrapit(1); }
       xusr:=42;
       inc(yusr);
     end;
     if ((yusr=22) and (xusr=77)) or (yusr=22) then begin
       cle(1);
       yusr:=4;
       xusr:=42;
       sendxy(xusr,yusr);
       ansicolor(urec.inputcolor);
       write(linebufu);
       sendxy(80-length(linebufu)+41,yusr);
     { wordwrapit(1); }
       yusr:=5;
       sendxy(xusr,yusr);
     end;
     sendxy(xusr,yusr);
     inc(xusr);
   end;
 end;

  procedure instruct;
  var i:integer;
  begin
  If initi then begin
    initi:=false;
    sendxy(1,4);
  end else
  end;

  Procedure ChangeVars;
      Begin
       backup:=c1;
       c1:=c2; c2:=c3; c3:=c4; c4:=c5; c5:=c6; c6:=c7; c7:=c8; c8:=backup;
       ansicolor(c1);
      End;

    Procedure GetCrazyVars;
      Begin
       If Color Then Begin
       c1:=configset.kkk1; c2:=configset.kkk2; c3:=configset.kkk3;
       c4:=configset.kkk4; c5:=configset.kkk5; c6:=configset.kkk6;
       c7:=configset.kkk7; c8:=configset.kkk8;
      End Else Begin
       c1:=urec.inputcolor;
       End;
      End;


procedure typedchar (k:char);
begin
  ChangeVars;
  locate;
  If (c1<1) and (c1>15) then getcrazyvars;
  if fromkbd then begin
    If Color then ansicolor(c1) else ansicolor(urec.promptcolor);
    linebufs:=linebufs+K;
  end else begin
    If Color then ansicolor(c1) else ansicolor(urec.inputcolor);
    linebufu:=linebufu+K;
  end;
  write(k)
end;

begin
  carrierloss:=false;
  chatmode:=false;
  writeln (^B^M);
  if wanted in urec.config then begin
    specialmsg ('(No longer wanted)');
    urec.config:=urec.config-[wanted];
    writeurec;
  end;
  if eightycols in urec.config then displaywid:=80 else displaywid:=40;
  clearbreak;
  nobreak:=true;
  writeln (^M^M,configset.entercha,^M^R);
  StartedTime:=TimeLeft;
  instruct;
  if not initi then
begin
   CLEARSCRE;
  sendXY(1,13); ANSiCOLOR(15);
  WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
  sendXy(1,13); ANSiCOLOR(7);
  WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
  sendXy(1,13); ANSiCOLOR(8);
  WriteLn('                          ViSiON 2/Way Chat v0.82'); Delay(100);
   if color then GetCrazyVars;
   init;
   clearscre;
   midline;
end;

  quit:=false;
  nobreak:=true;
  break:=false;
  repeat
    linecount:=0;
    if (not carrierloss) and (not carrier) then begin
      carrierloss:=true;
(*      gotoxy(1,4);
      writeln (^M'Warning: There is no carrier present.'^M) *)
    end;
    repeat until keyhit or (carrier and (numchars>0));
    fromkbd:=keyhit;
    ingetstr:=true;
    if fromkbd then
     k:=bioskey else
    k:=getchar;
    if k=#127 then k:=#8;
    if k > #127 then if ((ord(k) - 128) in [60,61]) then begin
      if (ord(k) - 128) = 60 then begin
        quit:=specialcommand;
        if not quit then instruct;
        clearbreak;
        unsplit;
      end;
      nobreak:=true;
      writeln (^M^M,configset.exitcha,^M^R);
      SetTimeLeft(StartedTime);
      write (#27'[J');
      bottomline;
      chainstr:='';
      input:='';
      write (#13);
      exit;
    end;
    case ord(k) of
      8:begin
      if (xsys>1) and fromkbd then
       begin
          modeminlock:=true;
          if xsys>1 then dec(xsys);
          sendxy(xsys,ysys);
          write (' ');
          sendxy(xsys,ysys);
          if length(linebufs)>0 then linebufs:=copy(linebufs,1,length(linebufs)-1);
          modeminlock:=false;
        end;
      if (xusr>42) and not fromkbd then
       begin
          modeminlock:=true;
          if xusr>42 then dec(xusr);
          sendxy(xusr,yusr);
          write (' ');
          sendxy(xsys,ysys);
          if length(linebufu)>0 then linebufu:=copy(linebufu,1,length(linebufu)-1);
          modeminlock:=false;
        end;
     end;
      0:;
      13:begin
           bottomline;
           if fromkbd then begin
             xsys:=1;
             inc(ysys);
         if (ysys>=22) then begin
           cle(0);
           ysys:=4;
           xsys:=1;
           sendxy(xsys,ysys);
           ansicolor(urec.statcolor);
           write(linebufs);
               ysys:=5;
         end;
             sendxy (xsys,ysys);
         linebufs:='';
       end else begin
             xusr:=42;
             inc(yusr);
         if (yusr>=22) then begin
               cle(1);
               yusr:=5;
               xusr:=42;
               ansicolor(urec.inputcolor);
               sendxy(xusr - 1,yusr);
               write(linebufu);
               sendxy(xusr,yusr);
             end;
             sendxy(xusr,yusr);
             linebufu:='';
           end;
         end;
       32:If not fromkbd then Begin linebufu:=''; typedchar (k) end
          else typedchar(k);
      33..255:typedchar (k);
      1..31:if fromkbd and carrier then sendchar(k);
    end
  until quit;
  chainstr:='';
  input:='';
  clearbreak
end;

Procedure BustChat; (* Pulldown Menus For ViSiON; Use'n Techo-Jock's ToolKit *)
Var Main_Choice,Choice,Error:integer;
   ScanTop, ScanBot:byte;
   M1,MM:Menu_record;
   Ch:char;
   X,Y:Byte;
   Done:Boolean;

Procedure Which_Chat;
begin
    Menu_Set(M1);
    With M1 do
    begin
        Heading1 := 'ViSiON v0.82 Online SysOp Chat Commands';
        Heading2 := 'Chat Commands';
        Topic[1] := '   Regular Color - Split Screen';
        Topic[2] := '   Multi-Colored - Split Screen';
        Topic[3] := '   Regular Color - Veritcal Chat';
        Topic[4] := '   Mulit-Colored - Vertical Chat';
        Topic[5] := '   Regular Color - One Line Chat';
        Topic[6] := '   SysOp Command Menu';
        Topic[7] := '   Quit Chat Menu';
        TotalPicks := 7;
        PicksPerLine := 1;            {one column of choices}
        Addprefix := 1;               {add function key prefixes}
        TopleftXY[1] := 0;            {system will center menu}
        TopleftXY[2] := 3;            {Y coordinate}
        Boxtype := 5;                 {fancy box}
        If ColorScreen then
        begin
            Colors[1] := white;           {hi forground}
            Colors[2] := magenta;            {hi background}
            Colors[3] := lightgray;             {lo foreground}
            Colors[4] := blue;       {lo background}
            Colors[5] := lightgray;            {box color}
        end
        else
        begin
            Colors[1] := white;           {hi forground}
            Colors[2] := black;            {hi background}
            Colors[3] := black;             {lo foreground}
            Colors[4] := lightgray;       {lo background}
            Colors[5] := white;            {box color}
        end;
        AllowEsc := false;            {inactivate the escape key}
        Margins := 5;
end;  {with M1 do}
end; {Define_Menu1}


Begin
    WriteLn(^R'■ '^A'One Moment'^R' ■');
    SplitScreen(25);
    Activate_Visible_Screen;
    SlideRestoreSCreen(2,Down);
    Clrscr;
    FillScreen(1,1,80,24,white,blue,chr(176));
    Findcursor(X,Y,ScanTop,ScanBot);
    OffCursor;
    Main_Choice := 1;
    Done:=False;
    repeat
     Which_Chat;
     DisplayMenu(M1,false,Main_Choice,Error);
     Case Main_Choice of
     1 :Begin Oncursor; Chat(False,False); Done:=True; End;
     2 :Begin Oncursor; Chat(False,True); Done:=True; End;
     3 :Begin OnCursor; RegChat(False); Done:=True; End;
     4 :Begin Oncursor; RegChat(True); Done:=TRue; End;
     5 :Begin OnCursor; OneLineChat; Done:=True End;
     6 :Begin Done:=True; Chat(True,False); Done:=True; End;
     7 :Done:=True;
     end;  {case}
until Done;
OnCursor;
ClrScr;
UnSplit;
Main_Choice:=1;
End;

begin
end.